home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tj50dsk1.zip / WINTTT5.PAS < prev   
Pascal/Delphi Source File  |  1989-01-31  |  29KB  |  983 lines

  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}                                       
  13.                      {       Unit:   WinTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-}       
  18.  
  19. unit  WinTTT5;
  20.  
  21. interface
  22.  
  23. uses CRT,DOS,FastTTT5,KeyTTT5;
  24.  
  25. Type
  26.  Direction = (Up, Down, Left, Right);
  27. Const
  28.     Shadow = 5;
  29. Var
  30.     Shadcolor    : byte;
  31.     DisplayLines : byte;
  32.  
  33. Procedure MoveFromScreen(var Source,Dest;Length:Word);
  34. Procedure MoveToScreen(var Source,Dest; Length:Word);
  35. Procedure SizeCursor(Top,Bot:byte);
  36. Procedure FindCursor(var X,Y,Top,Bot:byte);
  37. Procedure PosCursor(X,Y: integer);
  38. Procedure Fullcursor;
  39. Procedure HalfCursor;
  40. Procedure OnCursor;
  41. Procedure OffCursor;
  42. Procedure GotoXY(X,Y : byte);
  43. Function  WhereX: byte;
  44. Function  WhereY: byte;
  45. Function  GetScreenChar(X,Y:byte):char;
  46. Function  GetScreenAttr(X,Y:byte):byte;
  47. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  48. Procedure CreateScreen(Page:byte;Lines:byte);
  49. Procedure SaveScreen(Page:byte);
  50. Procedure RestoreScreen(Page:byte);
  51. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  52. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  53. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  54. Procedure DisposeScreen(Page:byte);
  55. Procedure SetCondensedLines;
  56. Procedure Set25Lines;
  57. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  58. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  59. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  60. Procedure PartSave(X1,Y1,X2,Y2:byte; VAR Dest);
  61. Procedure PartRestore(X1,Y1,X2,Y2:byte; VAR Source);
  62. Procedure Mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  63. Procedure GrowMkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  64. Procedure Rmwin;
  65. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  66. Procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  67. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  68. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  69. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  70. Procedure Activate_Visible_Screen;
  71. Procedure Activate_Virtual_Screen(Page:byte);
  72. Procedure Reset_StartUp_Mode;
  73.  
  74. Const
  75.     Max_Windows = 10;          {Change this constant as necessary}
  76.     Max_Screens = 10;          {Change this constant as necessary}
  77.     WindowCounter : byte = 0;
  78.     ScreenCounter : byte = 0;
  79.     ActiveVScreen: byte = 0;
  80.  
  81. Type
  82.     ScreenImage = record
  83.                        CursorX : byte;
  84.                        CursorY : byte;
  85.                        ScanTop : byte;
  86.                        ScanBot : byte;
  87.                        SavedLines:byte;
  88.                        ScreenPtr: pointer;
  89.                   end;
  90.     ScreenPtr = ^ScreenImage;
  91.     WindowImage = record
  92.                        ScreenPtr: Pointer;             {pointer to screen data}
  93.                        Coord    : array[1..4] of byte; {window coords}
  94.                        CursorX  : byte;                {cursor location}
  95.                        CursorY  : byte;
  96.                        ScanTop  : byte;                {cursor shape}
  97.                        ScanBot  : byte;
  98.                   end;
  99.     WindowPtr = ^WindowImage;
  100.  
  101. Var
  102.     Screen : array[1..Max_Screens] of ScreenPtr;
  103.     Win    : array[1..Max_Windows] of WindowPtr;
  104.     W_error: integer;     {Global error to report winTTT errors}
  105.     W_fatal: boolean;
  106.  
  107. IMPLEMENTATION
  108.  
  109. CONST
  110.     MonoAdr =$b000;
  111. VAR
  112.     StartTop,      {used to record initial screen state when program is run}
  113.     StartBot   : Byte;
  114.     StartMode  : word;
  115.  
  116. {$L WINTTT5}
  117.  
  118. {$F+}
  119.   Procedure MoveFromScreen(var Source,Dest;Length:Word); external;
  120.   Procedure MoveToScreen(var Source,Dest; Length:Word); external;
  121. {$F-}
  122.  
  123. Procedure WinTTT_Error(No : byte);
  124. {Updates W_error and optionally displays error message then halts program}
  125. var Msg : String;
  126. begin
  127.     W_error := No;
  128.     If W_fatal = true then
  129.     begin
  130.         Case No of
  131.         1 :  Msg := 'Max screens exceeded';
  132.         2 :  Msg := 'Max Windows Exceeded';
  133.         3 :  Msg := 'Insufficient memory to create screen';
  134.         4 :  Msg := 'Screen not saved cannot activate.';
  135.         5 :  Msg := 'Screen has not been created - cannot activate';
  136.         6 :  Msg := 'Screen has not been created - cannot dispose';
  137.         7 :  Msg := 'Screen has not been created - cannot restore';
  138.         8 :  Msg := 'Screen does not exist cannot clear';
  139.         9 :  Msg := 'Insufficient memory for Screen Copy/Move';
  140.         10:  Msg := 'Visible screen must be active for Window operations';
  141.         11:  Msg := 'Visible screen must be active for Message operations';
  142.         12:; {reserved for non-fatal error settings condensed mode}
  143.         13:  Msg := 'Can only save 25 screen lines - check CONST SavedLines';
  144.         else Msg := '?) -- Utterly confused';
  145.         end; {Case}
  146.         Msg := 'Fatal Error (WinTTT -- '+Msg;
  147.         Writeln(Msg);
  148.         Delay(5000);    {display long enough to read if child process}
  149.         Halt;
  150.     end;
  151. end;
  152.  
  153. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  154. {                                                                     }
  155. {     V I S I B L E    a n d    V I R T U A L  P R O C E D U R E S    }
  156. {                                                                     }
  157. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  158. Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  159. {transfers data from active virtual screen to Dest}
  160. var
  161.    I,width : byte;
  162.    ScreenAdr: integer;
  163. begin
  164.     width := succ(X2- X1);
  165.     For I :=  Y1 to Y2 do
  166.     begin
  167.      ScreenAdr := Vofs + Pred(I)*160 + Pred(X1)*2;
  168.      MoveFromScreen(Mem[Vseg:ScreenAdr],
  169.                     Mem[seg(Dest):ofs(dest)+(I-Y1)*width*2],
  170.                     width);
  171.     end;
  172. end;
  173.  
  174. Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  175. {restores data from Source and transfers to active virtual screen}
  176. var
  177.    I,width : byte;
  178.    ScreenAdr: integer;
  179. begin
  180.     width := succ(X2- X1);
  181.     For I :=  Y1 to Y2 do
  182.     begin
  183.      ScreenAdr := Vofs + Pred(I)*160 + Pred(X1)*2;
  184.      MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*width*2],
  185.                   Mem[Vseg:ScreenAdr],
  186.                   width);
  187.     end;
  188. end;
  189.  
  190. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  191. var
  192.    I : integer;
  193.    S : string;
  194. begin
  195.     W_error := 0;
  196.     Attrib(X1,Y1,X2,Y2,F,B);
  197.     S := Replicate(Succ(X2-x1),C);
  198.     For I := Y1 to Y2 do
  199.         PlainWrite(X1,I,S);
  200. end;
  201.  
  202. Procedure GetScreenWord(X,Y:byte;var Attr:byte; var Ch : char);
  203. {updates vars Attr and Ch with attribute and character bytes in screen
  204.  location (X,Y) of the active screen}
  205. Type
  206.     ScreenWordRec = record
  207.                          Attr : byte;
  208.                          Ch   : char;
  209.                     end;
  210. var
  211.    ScreenAdr: integer;
  212.    SW : ScreenWordRec;
  213. begin
  214.     ScreenAdr := Vofs + Pred(Y)*160 + Pred(X)*2;
  215.     MoveFromScreen(Mem[Vseg:ScreenAdr],mem[seg(SW):ofs(SW)],1);
  216.     Attr := SW.Attr;
  217.     Ch   := SW.Ch;
  218. end;
  219.  
  220. Function GetScreenChar(X,Y:byte):char;
  221. var
  222.    A : byte;
  223.    C : char;
  224. begin
  225.     GetScreenWord(X,Y,A,C);
  226.     GetScreenChar := C;
  227. end;
  228.  
  229. Function GetScreenAttr(X,Y:byte):byte;
  230. var
  231.    A : byte;
  232.    C : char;
  233. begin
  234.     GetScreenWord(X,Y,A,C);
  235.     GetScreenAttr := A;
  236. end;
  237.  
  238. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  239. var
  240.    I : integer;
  241. begin
  242.     St := '';
  243.     For I := X1 to X2 do
  244.         St := St + GetScreenChar(I,Y);
  245. end;
  246.  
  247. {++++++++++++++++++++++++++++++++++++++++++++++}
  248. {                                              }
  249. {         C U R S O R    R O U T I N E S       }
  250. {                                              }
  251. {++++++++++++++++++++++++++++++++++++++++++++++}
  252.  
  253. Procedure GotoXY(X,Y : byte);
  254. {intercepts normal Turbo GotoXY procedure, in case a virtual screen
  255.  is active.
  256. }
  257. begin
  258.     If VSeg = BaseOfScreen then
  259.        CRT.GotoXY(X,Y)
  260.     else
  261.        with Screen[ActiveVScreen]^ do
  262.        begin
  263.            CursorX := X;
  264.            CursorY := Y;
  265.        end; {with}
  266. end;  {proc GotoXY}
  267.  
  268. Function WhereX: byte;
  269. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  270.  is active.
  271. }
  272. begin
  273.     If VSeg = BaseOfScreen then
  274.        WhereX := CRT.WhereX
  275.     else
  276.        with Screen[ActiveVScreen]^ do
  277.            WhereX := CursorX;
  278. end; {of func WhereX}
  279.  
  280. Function WhereY: byte;
  281. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  282.  is active.
  283. }
  284. begin
  285.     If VSeg = BaseOfScreen then
  286.        WhereY := CRT.WhereY
  287.     else
  288.        with Screen[ActiveVScreen]^ do
  289.            WhereY := CursorY;
  290. end; {of func WhereY}
  291.  
  292. Procedure FindCursor(var X,Y,Top,Bot:byte);
  293. var
  294.    Reg : registers;
  295. begin
  296.   If VSeg = BaseOfScreen then    {visible screen is active}
  297.   begin   
  298.       Reg.Ax := $0F00;              {get page in Bx}
  299.       Intr($10,Reg);
  300.       Reg.Ax := $0300;
  301.       Intr($10,Reg);
  302.       With Reg do
  303.       begin
  304.         X := lo(Dx) + 1;
  305.         Y := hi(Dx) + 1;
  306.         Top := Hi(Cx) and $0F;
  307.         Bot := Lo(Cx) and $0F;
  308.       end;
  309.   end
  310.   else                            {virtual screen active}
  311.      with Screen[ActiveVScreen]^ do
  312.      begin
  313.          X := CursorX;
  314.          Y := CursorY;
  315.          Top := ScanTop;
  316.          Bot := ScanBot;
  317.      end;
  318. end;
  319.  
  320. Procedure PosCursor(X,Y: integer);
  321. var Reg : registers;
  322. begin
  323.     If VSeg = BaseOfScreen then    {visible screen is active}
  324.     begin   
  325.         Reg.Ax := $0F00;              {get page in Bx}
  326.         Intr($10,Reg);
  327.         with Reg do
  328.         begin
  329.           Ax := $0200;
  330.           Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
  331.         end;
  332.         Intr($10,Reg);
  333.     end
  334.     else                           {virtual screen active}
  335.        with Screen[ActiveVScreen]^ do
  336.        begin
  337.            CursorX := X;
  338.            CursorY := Y;
  339.        end;
  340. end;
  341.  
  342. Procedure SizeCursor(Top,Bot:byte);
  343. var Reg : registers;
  344. begin
  345.     If VSeg = BaseOfScreen then    {visible screen is active}
  346.        with Reg do
  347.        begin
  348.          ax := 1 shl 8;
  349.          cx := Top shl 8 + Bot;
  350.          INTR($10,Reg);
  351.        end
  352.     else                           {virtual screen active}
  353.        with Screen[ActiveVScreen]^ do
  354.        begin
  355.            ScanTop := Top;
  356.            ScanBot := Bot;
  357.        end;
  358. end;
  359.  
  360. Procedure HalfCursor;
  361. begin
  362.     If BaseOfScreen = MonoAdr then    
  363.        SizeCursor(8,13)    
  364.     else
  365.        SizeCursor(4,7);    
  366. end; {Proc HalfCursor}
  367.  
  368. Procedure Fullcursor;
  369. begin
  370.     If BaseOfScreen = MonoAdr then
  371.        SizeCursor(0,13)
  372.     else
  373.        SizeCursor(0,7);
  374. end;
  375.  
  376. Procedure OnCursor;
  377. begin
  378.     If BaseOfScreen = MonoAdr then
  379.        SizeCursor(12,13)
  380.     else
  381.        SizeCursor(6,7);
  382. end;
  383.  
  384. Procedure OffCursor;
  385. begin
  386.     Sizecursor(14,0);
  387. end;
  388.  
  389. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  390. {                                                    }
  391. {   S C R E E N   S A V I N G  R O U T I N E S       }
  392. {                                                    }
  393. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  394.  
  395. Procedure DisposeScreen(Page:byte);
  396. {Free memory and set pointer to nil}
  397. begin
  398.     If Screen[Page] = nil then
  399.     begin
  400.        WinTTT_Error(6);
  401.        exit;
  402.     end
  403.     else
  404.        W_error := 0;
  405.     FreeMem(Screen[Page]^.ScreenPtr,Screen[Page]^.SavedLines*160);
  406.     Freemem(Screen[Page],SizeOf(Screen[Page]^));
  407.     Screen[page] := nil;
  408.     If ActiveVscreen = Page then
  409.        Activate_Visible_Screen;
  410.     dec(ScreenCounter);
  411. end;
  412.  
  413. Procedure SaveScreen(Page:byte);
  414. {Save screen display and cursor details}
  415. begin
  416.     If (Page > Max_Screens) then
  417.     begin
  418.       WinTTT_Error(1);
  419.       exit;
  420.     end;
  421.     If ((Screen[Page] <> nil) and (DisplayLines <> Screen[Page]^.SavedLines)) then
  422.         DisposeScreen(Page);
  423.     If Screen[Page] = nil then            {need to allocate memory}
  424.     begin
  425.         If MaxAvail < SizeOf(Screen[Page]^) then
  426.         begin
  427.             WinTTT_Error(3);
  428.             exit;
  429.         end;
  430.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  431.         If MaxAvail < DisplayLines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  432.         begin
  433.             WinTTT_Error(3);
  434.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  435.             Screen[Page] := nil;
  436.             exit;
  437.         end;
  438.         GetMem(Screen[Page]^.ScreenPtr,DisplayLines*160);
  439.         Inc(ScreenCounter);
  440.     end;
  441.     With Screen[Page]^ do
  442.     begin
  443.        FindCursor(CursorX,CursorY,ScanTop,ScanBot);     {Save Cursor posn. and shape}
  444.        SavedLines := DisplayLines;
  445.        MoveFromScreen(Mem[BaseOfScreen:0],Screen[Page]^.ScreenPtr^,DisplayLines*80);
  446.     end;
  447.     W_error := 0;
  448. end;
  449.  
  450. Procedure RestoreScreen(Page:byte);
  451. {Display a screen that was previously saved}
  452. begin
  453.     If Screen[Page] = nil then
  454.     begin
  455.        WinTTT_Error(7);
  456.        exit;
  457.     end
  458.     else
  459.        W_error := 0;
  460.     With Screen[Page]^ do
  461.     begin
  462.         MoveToScreen(ScreenPtr^,mem[BaseOfScreen:0], 80*SavedLines);
  463.         PosCursor(CursorX,CursorY);
  464.         SizeCursor(ScanTop,ScanBot);
  465.     end;
  466. end;  {Proc RestoreScreen}
  467.  
  468.  
  469. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  470. {Move from heap to screen, part of saved screen}
  471. Var
  472.    I,width     : byte;
  473.    ScreenAdr,
  474.    PageAdr     : integer;
  475. begin
  476.     If Screen[Page] = nil then
  477.     begin
  478.        WinTTT_Error(7);
  479.        exit;
  480.     end
  481.     else
  482.        W_error := 0;
  483.     Width := succ(X2- X1);
  484.     For I :=  Y1 to Y2 do
  485.     begin
  486.         ScreenAdr := pred(Y+I-Y1)*160 + Pred(X)*2;
  487.         PageAdr   := Pred(I)*160 + Pred(X1)*2;
  488.         MoveToScreen(Mem[Seg(Screen[Page]^.ScreenPtr^):ofs(Screen[Page]^.ScreenPtr^)+PageAdr],
  489.                      Mem[BaseOfScreen:ScreenAdr],
  490.                      width);
  491.     end;
  492. end;
  493.  
  494. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  495. {Display a screen that was previously saved, with fancy slide}
  496. Var I : byte;
  497. begin
  498.     If Screen[Page] = nil then
  499.     begin
  500.        WinTTT_Error(7);
  501.        exit;
  502.     end
  503.     else
  504.        W_error := 0;
  505.     Case Way of
  506.     Up    : begin
  507.                 For I := DisplayLines downto 1 do
  508.                 begin
  509.                     PartRestoreScreen(Page,
  510.                                       1,1,80,succ(DisplayLines -I),
  511.                                       1,I);
  512.                     Delay(50);
  513.                 end;
  514.             end;
  515.     Down  : begin
  516.                 For I := 1 to DisplayLines do
  517.                 begin
  518.                     PartRestoreScreen(Page,
  519.                                       1,succ(DisplayLines -I),80,DisplayLines,
  520.                                       1,1);
  521.                     Delay(50);  {savor the moment!}
  522.                 end;
  523.             end;
  524.     Left  : begin
  525.                 For I := 1 to 80 do
  526.                 begin
  527.                     PartRestoreScreen(Page,
  528.                                       1,1,I,DisplayLines,
  529.                                       succ(80-I),1);
  530.                 end;
  531.             end;
  532.     Right : begin
  533.                 For I := 80 downto 1 do
  534.                 begin
  535.                     PartRestoreScreen(Page,
  536.                                       I,1,80,DisplayLines,
  537.                                       1,1);
  538.                 end;
  539.             end;
  540.     end; {case}
  541.     PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
  542.     SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
  543. end;   {Proc SlideRestoreScreen}
  544.  
  545.  
  546. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  547. {Display a screen that was previously saved, with fancy slide}
  548. Var I : byte;
  549. begin
  550.     If Screen[Page] = nil then
  551.     begin
  552.        WinTTT_Error(7);
  553.        exit;
  554.     end
  555.     else
  556.        W_error := 0;
  557.     Case Way of
  558.     Up    : begin
  559.                 For I := Y2 downto Y1 do
  560.                 begin
  561.                     PartRestoreScreen(Page,
  562.                                       X1,Y1,X2,Y1+Y2-I,
  563.                                       X1,I);
  564.                     Delay(50);
  565.                 end;
  566.             end;
  567.     Down  : begin
  568.                 For I := Y1 to Y2 do
  569.                 begin
  570.                     PartRestoreScreen(Page,
  571.                                       X1,Y1+Y2 -I,X2,Y2,
  572.                                       X1,Y1);
  573.                     Delay(50);  {savor the moment!}
  574.                 end;
  575.             end;
  576.     Left  : begin
  577.                 For I := X1 to X2 do
  578.                 begin
  579.                     PartRestoreScreen(Page,
  580.                                       X1,Y1,I,Y2,
  581.                                       X1+X2-I,Y1);
  582.                 end;
  583.             end;
  584.     Right : begin
  585.                 For I := X2 downto X1 do
  586.                 begin
  587.                     PartRestoreScreen(Page,
  588.                                       I,Y1,X2,Y2,
  589.                                       X1,Y1);
  590.                 end;
  591.             end;
  592.     end; {case}
  593. end;   {Proc PartSlideRestoreScreen}
  594.  
  595.  
  596. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  597. {                                                                              }
  598. {     V I R T U A L    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  599. {                                                                              }
  600. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  601.  
  602. Procedure Clear_Vscreen(page:byte);
  603. var
  604.    Tseg, Tofs : word;
  605. begin
  606.     If Screen[Page] = nil then
  607.     begin
  608.        WinTTT_Error(8);
  609.        exit;
  610.     end
  611.     else
  612.        W_error := 0;
  613.     Tseg := Vseg;
  614.     Tofs := Vofs;
  615.     Vseg := Seg(Screen[Page]^.ScreenPtr^);
  616.     Vofs := Ofs(Screen[Page]^.ScreenPtr^);
  617.     ClearText(1,1,80,Screen[Page]^.SavedLines,yellow,black);
  618.     Vseg := Tseg;
  619.     Vofs := Tofs;
  620. end;
  621.  
  622. Procedure CreateScreen(Page:byte;Lines:byte);
  623. begin
  624.     W_error := 0;
  625.     If (Page > Max_Screens) then
  626.     begin
  627.        WinTTT_Error(1);
  628.        exit;
  629.     end;
  630.     If ((Screen[Page] <> nil) and (Lines <> Screen[Page]^.SavedLines)) then
  631.         DisposeScreen(Page);
  632.     If Screen[Page] = nil then            {need to allocate memory}
  633.     begin
  634.         If MaxAvail < SizeOf(Screen[Page]^) then
  635.         begin
  636.             WinTTT_Error(3);
  637.             exit;
  638.         end;
  639.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  640.         If MaxAvail < Lines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  641.         begin
  642.             WinTTT_Error(3);
  643.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  644.             Screen[Page] := nil;
  645.             exit;
  646.         end;
  647.         GetMem(Screen[Page]^.ScreenPtr,Lines*160);
  648.         Inc(ScreenCounter);
  649.     end;
  650.     With Screen[Page]^ do
  651.     begin
  652.         If BaseOfScreen = $B000 then
  653.         begin
  654.             ScanTop := 12;
  655.             ScanBot := 13;
  656.         end
  657.         else
  658.         begin
  659.             ScanTop := 6;
  660.             ScanBot := 7;
  661.         end;
  662.         CursorX := 1;
  663.         CursorY := 1;
  664.         SavedLines := Lines;
  665.         Clear_Vscreen(Page);
  666.     end;
  667. end;
  668.  
  669. Procedure Activate_Visible_Screen;
  670. begin
  671.     VSeg := BaseOfScreen;
  672.     VOfs := 0;
  673.     ActiveVscreen := 0;
  674. end;
  675.  
  676. Procedure Activate_Virtual_Screen(Page:byte);
  677. {Page zero signifies the visible screen}
  678. begin
  679.     If Screen[Page] = nil then
  680.        WinTTT_Error(4)
  681.     else
  682.     begin
  683.        W_error := 0;
  684.        If Page = 0 then
  685.           Activate_Visible_Screen
  686.        else
  687.        begin
  688.            VSeg := Seg(Screen[Page]^.ScreenPtr^);
  689.            VOfs := Ofs(Screen[Page]^.ScreenPtr^);
  690.            ActiveVScreen := page;
  691.        end;
  692.     end;
  693. end;
  694.  
  695. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  696. {                                                                              }
  697. {     V I S I B L E    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  698. {                                                                              }
  699. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  700.  
  701. Procedure SetCondensedLines;
  702. begin
  703.     If EGAVGASystem then
  704.     begin
  705.         W_Error := 0;
  706.         TextMode(Lo(LastMode)+Font8x8);
  707.         DisplayLines := succ(Hi(WindMax));
  708.     end
  709.     else
  710.         W_Error := 12;
  711. end;  {proc SetCondensedDisplay}
  712.  
  713. Procedure Set25Lines;
  714. begin
  715.     TextMode(Lo(LastMode));
  716.     DisplayLines := succ(Hi(WindMax));
  717. end;
  718.  
  719.  
  720. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  721. {copies text and attributes from one part of screen to another}
  722. Var
  723.    S : word;
  724.    SPtr : pointer;
  725. begin
  726.     W_error := 0;
  727.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  728.     If Maxavail < S then
  729.        WinTTT_Error(9)
  730.     else
  731.     begin
  732.         GetMem(SPtr,S);
  733.         PartSave(X1,Y1,X2,Y2,SPtr^);
  734.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  735.         FreeMem(Sptr,S);
  736.     end;
  737. end; {CopyScreenBlock}
  738.  
  739. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  740. {Moves text and attributes from one part of screen to another,
  741.  replacing with Replace_Char}
  742. const
  743.   Replace_Char = ' ';
  744. Var
  745.    S : word;
  746.    SPtr : pointer;
  747.    I : Integer;
  748.    ST : string;
  749. begin
  750.     W_error := 0;
  751.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  752.     If Maxavail < S then
  753.        WinTTT_Error(9)
  754.     else
  755.     begin
  756.         GetMem(SPtr,S);
  757.         PartSave(X1,Y1,X2,Y2,SPtr^);
  758.         St := Replicate(succ(X2-X1),Replace_Char);
  759.         For I := Y1 to Y2 do
  760.             PlainWrite(X1,I,St);
  761.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  762.         FreeMem(Sptr,S);
  763.     end;
  764. end; {Proc MoveScreenBlock}
  765.  
  766. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  767. {used for screen scrolling, uses Copy & Plainwrite for speed}
  768. const
  769.   Replace_Char = ' ';
  770. var
  771.   I : integer;
  772. begin
  773.     W_error := 0;
  774.     Case Way of
  775.     Up   : begin
  776.                CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  777.                PlainWrite(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  778.            end;
  779.     Down : begin
  780.                CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  781.                PlainWrite(X1,Y1,replicate(succ(X2-X1),Replace_Char));
  782.            end;
  783.     Left : begin
  784.                CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  785.                For I := Y1 to Y2 do
  786.                    PlainWrite(X2,1,Replace_Char);
  787.            end;
  788.     Right: begin
  789.                CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  790.                For I := Y1 to Y2 do
  791.                    PlainWrite(X1,1,Replace_Char);
  792.            end;
  793.     end; {case}
  794. end;
  795.  
  796. procedure CreateWin(x1,y1,x2,y2,F,B,boxtype:integer);
  797. {called by MkWin and GrowMkWin}
  798. begin
  799.     If WindowCounter >= Max_Windows then
  800.     begin
  801.        WinTTT_Error(2);
  802.        exit;
  803.     end;
  804.     If MaxAvail < sizeOf(Win[WindowCounter]^) then
  805.     begin
  806.        WinTTT_Error(3);
  807.        exit;
  808.     end
  809.     else
  810.        W_error := 0;
  811.     Inc(WindowCounter);
  812.     GetMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));    {allocate space}
  813.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  814.     begin
  815.         X1 := pred(X1);    {increase dimensions for the box}
  816.         Y2 := succ(Y2);
  817.     end;
  818.     If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  819.     begin
  820.        WinTTT_Error(3);
  821.        exit;
  822.     end;
  823.     GetMem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
  824.     PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
  825.     with Win[WindowCounter]^ do
  826.     begin
  827.       Coord[1] := X1;
  828.       Coord[2] := Y1;
  829.       Coord[3] := X2;
  830.       Coord[4] := Y2;
  831.       FindCursor(CursorX,CursorY,ScanTop,ScanBot);
  832.     end;  {with}
  833. end; {Proc CreateWin}
  834.  
  835. procedure mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  836. {Main procedure for creating window}
  837. var I : integer;
  838. begin
  839.     If ActiveVscreen <> 0 then
  840.     begin
  841.         W_error := 10;
  842.         exit;
  843.     end
  844.     else
  845.         W_error := 0;
  846.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  847.     If (BoxType in [5..9]) and (X1 > 1) then
  848.        FBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  849.     else
  850.        FBox(x1,y1,x2,y2,F,B,boxtype);
  851.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  852.     begin
  853.         For I := succ(Y1) to succ(Y2) do
  854.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  855.         WriteAt(X1,succ(Y2),Shadcolor,black,
  856.                 replicate(X2-succ(X1),chr(219)));
  857.     end;
  858. end;
  859.  
  860. procedure GrowMKwin(x1,y1,x2,y2,F,B,boxtype:integer);
  861. {same as MKwin but window explodes}
  862. var I : integer;
  863. begin
  864.     If ActiveVscreen <> 0 then
  865.     begin
  866.         W_error := 10;
  867.         exit;
  868.     end
  869.     else
  870.         W_error := 0;
  871.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  872.     If (BoxType in [5..9]) and (X1 > 1) then
  873.        GrowFBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  874.     else
  875.        GrowFBox(x1,y1,x2,y2,F,B,boxtype);
  876.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  877.     begin
  878.         For I := succ(Y1) to succ(Y2) do
  879.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  880.         WriteAt(X1,succ(Y2),Shadcolor,black,
  881.                 replicate(X2-succ(X1),chr(219)));
  882.     end;
  883. end;
  884.  
  885. Procedure RmWin;
  886. begin
  887.     If ActiveVscreen <> 0 then
  888.     begin
  889.         W_error := 10;
  890.         exit;
  891.     end
  892.     else
  893.         W_error := 0;
  894.     If WindowCounter > 0 then
  895.     begin
  896.         with  Win[WindowCounter]^ do
  897.         begin
  898.             PartRestore(Coord[1],Coord[2],Coord[3],Coord[4],ScreenPtr^);
  899.             PosCursor(CursorX,CursorY);
  900.             SizeCursor(ScanTop,ScanBot);
  901.             FreeMem(ScreenPtr,succ(Coord[4]-coord[2])*succ(coord[3]-coord[1])*2);
  902.             FreeMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
  903.         end; {with}
  904.         Dec(WindowCounter);
  905.     end;
  906. end;
  907.  
  908. procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  909. var
  910.  CX,CY,CT,CB,I,locC:integer;
  911.  SavedLine : array[1..160] of byte;
  912. begin
  913.     If ActiveVscreen <> 0 then
  914.     begin
  915.         W_error := 11;
  916.         exit;
  917.     end
  918.     else
  919.         W_error := 0;
  920.     PartSave(X,Y,pred(X)+length(St),Y,SavedLine);
  921.     WriteAT(X,Y,F,B,St);
  922.     Ch := GetKey;
  923.     PartRestore(X,Y,pred(X)+length(St),Y,SavedLine);
  924. end;
  925.  
  926. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  927. var Ch : char;
  928. begin
  929.     TempMessageCH(X,Y,F,B,ST,Ch);
  930. end;              
  931.  
  932. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  933. begin
  934.     If ActiveVscreen <> 0 then
  935.     begin
  936.         W_error := 11;
  937.         exit;
  938.     end
  939.     else
  940.         W_error := 0;
  941.     MkWin(X1,Y1,succ(X1)+length(St),Y1+2,F,B,Boxtype);
  942.     WriteAt(succ(X1),Succ(Y1),F,B,St);
  943.     Ch := getKey;
  944.     Rmwin;
  945. end;
  946.  
  947. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  948. var Ch : char;
  949. begin
  950.     TempMessageBoxCh(X1,Y1,F,B,Boxtype,St,Ch);
  951. end;
  952.  
  953. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  954.  
  955. Procedure InitWinTTT;
  956. {set Pointers to nil for validity checking}
  957. Var
  958.   I : integer;
  959.   X,Y : byte;
  960. begin
  961.     For I := 1 to Max_Screens do
  962.         Screen[I] := nil;
  963.     StartMode := LastMode;           { record the initial state of screen when program was executed}
  964.     DisplayLines := succ(Hi(WindMax));
  965.     FindCursor(X,Y,StartTop,StartBot);
  966. end;
  967.  
  968.  
  969. Procedure Reset_StartUp_Mode;
  970. {resets monitor mode and cursor settings to the state they
  971.  were in at program startup}
  972. begin
  973.     TextMode(StartMode);
  974.     SizeCursor(StartTop,StartBot);
  975. end; {proc StartUp_Mode}
  976.  
  977. begin
  978.     InitWinTTT;
  979.     W_error := 0;
  980.     W_fatal := false;   {don't terminate program if fatal error}
  981.     Shadcolor := darkgray;
  982. end.
  983.